home *** CD-ROM | disk | FTP | other *** search
/ Whiteline: delta / whiteline CD Series - delta.iso / progtool / modula2 / m2d2 / rcsmaker / rsc2mod.msk next >
Text File  |  1995-11-25  |  3KB  |  118 lines
  1. IMPLEMENTATION MODULE @
  2.  
  3. (*$S-,$T-,$Q+*)
  4.  
  5. FROM SYSTEM     IMPORT  ADDRESS,        CODE;
  6.  
  7. FROM GEMAES     IMPORT  ResourceObjectFix;
  8.  
  9. IMPORT GEMAESbase;
  10.  
  11.  
  12. CONST   (* idx's & nr's *)@
  13.         nrTrees         = @;    idxTree         = @;@
  14.         nrObjects       = @;    idxObject       = @;@
  15.         nrTEdInfos      = @;    idxTEdInfo      = @;@
  16.         nrIconBlks      = @;    idxIconBlk      = @;@
  17.         nrBitBlks       = @;    idxBitBlk       = @;@
  18.         nrFreeStrings   = @;    idxFreeString   = @;@
  19.         nrFreeImages    = @;    idxFreeImage    = @;@
  20.  
  21.  
  22. (*$P-*)
  23. PROCEDURE RSCdata@;
  24.  
  25.    BEGIN
  26. @      CODE ( @, @ );
  27. @   END RSCdata@;@
  28.  
  29.  
  30. PROCEDURE RelocateRSC;
  31.  
  32.    VAR  i       : INTEGER;
  33.         x       : ADDRESS;
  34. @
  35.         Trees   : POINTER TO ARRAY [ 0..nrTrees-1 ] OF ADDRESS;@
  36.         Objects : POINTER TO ARRAY [ 0..nrObjects-1 ] OF GEMAESbase.Object;@
  37.         TEdInfos: POINTER TO ARRAY [ 0..nrTEdInfos-1 ] OF GEMAESbase.TEdInfo;@
  38.         Icons   : POINTER TO ARRAY [ 0..nrIconBlks-1 ] OF GEMAESbase.IconBlk;@
  39.         BitBlks : POINTER TO ARRAY [ 0..nrBitBlks-1 ] OF GEMAESbase.BitBlk;@
  40.         FreeStr : POINTER TO ARRAY [ 0..nrFreeStrings-1 ] OF ADDRESS;@
  41.         FreeImg : POINTER TO ARRAY [ 0..nrFreeImages-1 ] OF ADDRESS;@
  42.  
  43.    BEGIN
  44.       WITH GEMAESbase.AESGlobal DO@
  45.          apPMem := ADDRESS ( RSCdata0 );
  46.          apPTree := ADDRESS ( RSCdata0 ) + idxTree;
  47.          Trees := apPTree@
  48.       END;
  49. @
  50.       x := ADDRESS ( RSCdata@ );@
  51.  
  52.       FOR i := 0 TO nrTrees-1 DO
  53.          (*$T-*)
  54.          INC ( Trees^[ i ], LONGCARD ( RSCdata0 ) )
  55.          (*$T=*)
  56.       END;
  57. @
  58.       Objects := ADDRESS ( RSCdata0 ) + idxObject;
  59.       FOR i := 0 TO nrObjects-1 DO
  60.          WITH Objects^[ i ] DO
  61.             IF ( obType # GEMAESbase.GBOX ) AND
  62.                ( obType # GEMAESbase.GBOXCHAR ) AND
  63.                ( obType # GEMAESbase.GIBOX )
  64.             THEN (*$T-*)
  65.                  INC ( obSpec, LONGCARD ( RSCdata0 ) )
  66.                  (*$T=*)
  67.             END;
  68.             ResourceObjectFix ( Objects, i )
  69.          END
  70.       END;
  71. @
  72.       TEdInfos := ADDRESS ( RSCdata0 ) + idxTEdInfo;
  73.       FOR i := 0 TO nrTEdInfos-1 DO
  74.          WITH TEdInfos^[ i ] DO
  75.             (*$T-*)
  76.             INC ( tePText,  LONGCARD ( RSCdata0 ) );
  77.             INC ( tePTmplt, LONGCARD ( RSCdata0 ) );
  78.             INC ( tePValid, LONGCARD ( RSCdata0 ) )
  79.             (*$T=*)
  80.          END
  81.       END;
  82. @
  83.       Icons := ADDRESS ( RSCdata0 ) + idxIconBlk;
  84.       FOR i := 0 TO nrIconBlks-1 DO
  85.          WITH Icons^[ i ] DO
  86.             (*$T-*)
  87.             INC ( ibPMask,  LONGCARD ( RSCdata0 ) );
  88.             INC ( ibPData, LONGCARD ( RSCdata0 ) );
  89.             INC ( ibPText, LONGCARD ( RSCdata0 ) )
  90.             (*$T=*)
  91.          END
  92.       END;
  93. @
  94.       BitBlks := ADDRESS ( RSCdata0 ) + idxBitBlk;
  95.       FOR i := 0 TO nrBitBlks-1 DO
  96.          (*$T-*)
  97.          INC ( BitBlks^[ i ].biPData, LONGCARD ( RSCdata0 ) )
  98.          (*$T=*)
  99.       END;
  100. @
  101.       FreeStr := ADDRESS ( RSCdata0 ) + idxFreeString;
  102.       FOR i := 0 TO nrFreeStrings-1 DO
  103.          (*$T-*)
  104.          INC ( FreeStr^[ i ], LONGCARD ( RSCdata0 ) )
  105.          (*$T=*)
  106.       END;
  107. @
  108.       FreeImg := ADDRESS ( RSCdata0 ) + idxFreeImage;
  109.       FOR i := 0 TO nrFreeImages-1 DO
  110.          (*$T-*)
  111.          INC ( FreeImg^[ i ], LONGCARD ( RSCdata0 ) )
  112.          (*$T=*)
  113.       END
  114. @
  115.    END RelocateRSC;
  116.  
  117. END @.@
  118.